--<<<
format debug "-- Compiling Slider Class . . .\n" undefined undefined

class Slider(GroupPresenter)
inst vars
	id
	thumb
	track
	minY
	maxY
	minValue
	maxValue
	currentValue
	connectedObject
	notifyMethod
	--Event Interests
	mouseDown
	mouseUp
	mouseMove
	mouseLeaving
end

method init self {class slider} #rest args #key castNum: lingo: dirInfo:->
(
	apply nextMethod self args
	local castList := dirInfo[@cast]
	self.id := findSXKey(lingo, "id")
	print castlist[castNum] --debug
	local track := (new TwoDShape boundary:castlist[castNum].boundary)
	if track = empty do (
		format debug "Slider castNum: %*\n" castNum @unadorned
		report GeneralError "problem with castNum parameter"
	)
	prepend self track
	self.track := track
	local thumbCast := castFromName(findSXKey(lingo, "thumb"))
	format debug "thumbCast = %*\n"  thumbCast @unadorned --debug
	local thumbBmp := thumbCast.boundary
	format debug "thumbBmp = %*\n"  thumbBmp @unadorned --debug
	thumbBmp.matteColor := whiteColor
	local thumb := (new TwoDShape boundary:thumbBmp)
	if thumb <> empty do (
		prepend self thumb
		self.thumb := thumb
		local tHt := thumb.height
		local myRect := self.bbox
		self.minY := myRect.y1 + tHt
		self.maxY := myRect.y2 - tHt
	)
	self.minValue := -50
	self.maxValue := 50
	self.currentValue := 0
	self.connectedObject := self.notifyMethod := undefined
	return self
)

method mouseDownAction self {class Slider} theInterest theEvent ->
(
	local addInterset := (e -> if not e.advertised do addEventInterest e)
	addInterset self.mouseMove
--	addInterset self.mouseUp
--	addInterset self.mouseLeaving
)

method mouseUpAction self {class Slider} theInterest theEvent ->
(
	local disconn :=  ( myInterest -> if myInterest.advertised do removeEventInterest myInterest)
	disconn self.mouseMove
--	disconn self.mouseUp
--	disconn self.mouseLeaving
)

method mouseMoveAction self {class Slider} theInterest theEvent ->
(
	local newY := theEvent.localCoords.y
	local minY := self.minY
	local maxY := self.maxY
	if newY < minY do newY :=  minY
	if newY > self.maxY do newY := maxY
	if  newY <> self.currentValue do (
		self.thumb.y := newY
		notifyChanged self true
		local minY := self.minY
		local maxY := self.maxY
		local minValue := self.minValue
		local maxValue := self.maxValue
		local Ypct := (maxY  - newY) / (maxY - minY)
		local newVal := minValue + ((maxValue - minValue)*Ypct)
		self.currentValue := newVal
		local connObj := self.connectedObject
		if connObj <> undefined do (
			self.notifyMethod connObj newVal
		)
	)
)

method setCurrValue self  {class Slider} value ->
(
	self.currentValue := value
	local minY := self.minY
	local maxY := self.maxY
	local minValue := self.minValue
	local maxValue := self.maxValue
	local valpct := value / (maxValue - minValue)
	local newY := (minY + ((maxY - minY)*valpct)) as integer
	self.thumb.y := newY
	notifyChanged self true
)

method connect self  {class Slider} #rest args #key values:(#(-100,100)) target: changeMethod:->
(
	self.connectedObject := target
	self.notifyMethod := changeMethod
	self.minValue := values[1]
	self.maxValue := values[2]
)

method hook self  {class Slider}->
(
	local mdEvnt := self.mouseDown
	if not (isAKindOf mdEvnt MouseDownEvent) do (
		mdEvnt := new MouseDownEvent
		mdEvnt.eventReceiver := mouseDownAction
		mdEvnt.authorData := self
		mdEvnt.device := new MouseDevice
		mdEvnt.presenter := self.thumb
		self.mouseDown := mdEvnt
	)
	addEventInterest mdEvnt
	
	local muEvent := self.mouseUp
	if not (isAKindOf muEvent MouseUpEvent) do (
		muEvent := new MouseUpEvent
		muEvent.eventReceiver := mouseUpAction
		muEvent.authorData := self
		muEvent.device := mdEvnt.device
		muEvent.presenter := self.presentedBy
		muEvent.matchedInterest := mdEvnt
		self.mouseUp := muEvent
	)
	addEventInterest muEvent

	local mmEvent := self.mouseMove
	if not (isAKindOf mmEvent MouseMoveEvent) do (
		mmEvent := new MouseMoveEvent
		mmEvent.eventReceiver := mouseMoveAction
		mmEvent.authorData := self
		mmEvent.device := mdEvnt.device
		mmEvent.presenter := self
		mmEvent.matchedInterest := mdEvnt
		self.mouseMove := mmEvent
	)
	local mlEvent := self.mouseLeaving
	
	if not (isAKindOf mmEvent MouseCrossingEvent) do (
		mlEvent := new MouseCrossingEvent
		mlEvent.eventReceiver := mouseUpAction
		mlEvent.authorData := self
		mlEvent.device := mdEvnt.device
		mlEvent.presenter := self
		self.mouseLeaving := mlEvent
	)
	addEventInterest mlEvent
)

method unhook self {class Slider}->
(
	local disconn :=  ( myInterest -> if myInterest.advertised do removeEventInterest myInterest)
	disconn self.mouseUp
	disconn self.mouseDown
	disconn self.mouseMove
)

#(Slider, #("id"),#("hook","unhook","connect"))
-->>>
